Antecedentes
source('code/antecedentes.R')
## `summarise()` has grouped output by 'edad'. You can override using the
## `.groups` argument.
## New names:
Variacion Interanual
Tasa básica pasiva
### Poblaciones #### Tasas de mortalidad
Esperanzas al nacer
Empleados de la empresa ABC
Primer ejercicio
Punto A
tablas_activos <- proyeccion_demografica_activos(base_empleados, tablas_supen)
llamamos es script con los gráficos.
source('code/graficos_activos.R')
fig_activos_vivos
Punto B
Punto C
fig_activos_muertos
Punto D
Punto E
Para esta sección, se toman las proyecciones demográficas ya hechas anteriormente.
En primer lugar, creamos las tablas en cuestión que nos ayudarán a graficar.
tabla_proy_fin <- proyeccion_financiera(tablas_activos, inflacion = 0.03)
Punto F
Punto G
Punto H
Estas son las primas para cada empleado tasa tomando en cuenta la inflación por medio de la ecuación de Fisher (1+i) = (1+tasa_real)(1+inflación), en este caso 0.0712 utilizando 0.04 tasa real y 0.03 de la inflación.
#Primas para empleados
Primas<-Calcula_prima_individuales(base_empleados,tablas_supen,5000000,1000000,300000,0.04)
#Base de empleados de combinaciones únicas
base_unicas<- unico(base_empleados)
#Primas para empleados, Hombre o Mujer y su respectiva edad
Primas_unicas <- Calcula_prima_individuales(base_unicas,tablas_supen,5000000,1000000,300000,0.04)
Primas_unicas <- Primas_unicas%>%
mutate(Sexo = if_else(Sexo == 1,'Hombre', 'Mujer')) %>%
select(-c(`Empleado`,`anualidad`,`beneficios`))
tabla_latex_primas_unicas <- xtable(Primas_unicas)
print(tabla_latex_primas_unicas)
## % latex table generated in R 4.3.1 by xtable 1.8-4 package
## % Fri Jun 28 18:23:18 2024
## \begin{table}[ht]
## \centering
## \begin{tabular}{rlrr}
## \hline
## & Sexo & Edad & Primas \\
## \hline
## 1 & Hombre & 20.00 & 448352.22 \\
## 2 & Hombre & 21.00 & 469172.72 \\
## 3 & Hombre & 22.00 & 491153.11 \\
## 4 & Hombre & 23.00 & 514381.83 \\
## 5 & Hombre & 24.00 & 538956.02 \\
## 6 & Hombre & 25.00 & 564983.46 \\
## 7 & Hombre & 26.00 & 592580.29 \\
## 8 & Hombre & 27.00 & 621875.39 \\
## 9 & Hombre & 28.00 & 653010.56 \\
## 10 & Hombre & 29.00 & 686142.08 \\
## 11 & Hombre & 30.00 & 721442.82 \\
## 12 & Hombre & 31.00 & 759108.88 \\
## 13 & Hombre & 32.00 & 799361.94 \\
## 14 & Hombre & 33.00 & 842450.84 \\
## 15 & Hombre & 34.00 & 888657.32 \\
## 16 & Hombre & 35.00 & 938301.33 \\
## 17 & Hombre & 36.00 & 991748.36 \\
## 18 & Hombre & 37.00 & 1049413.95 \\
## 19 & Hombre & 38.00 & 1111772.84 \\
## 20 & Hombre & 39.00 & 1179373.18 \\
## 21 & Hombre & 40.00 & 1252851.53 \\
## 22 & Hombre & 41.00 & 1332951.26 \\
## 23 & Hombre & 42.00 & 1420542.79 \\
## 24 & Hombre & 43.00 & 1516657.22 \\
## 25 & Hombre & 44.00 & 1622525.16 \\
## 26 & Hombre & 45.00 & 1739633.99 \\
## 27 & Hombre & 46.00 & 1869785.77 \\
## 28 & Hombre & 47.00 & 2015180.36 \\
## 29 & Hombre & 48.00 & 2178528.97 \\
## 30 & Hombre & 49.00 & 2363220.87 \\
## 31 & Hombre & 50.00 & 2573554.16 \\
## 32 & Hombre & 51.00 & 2815054.83 \\
## 33 & Hombre & 52.00 & 3094950.61 \\
## 34 & Hombre & 53.00 & 3422881.19 \\
## 35 & Hombre & 54.00 & 3812014.45 \\
## 36 & Hombre & 55.00 & 4280802.20 \\
## 37 & Hombre & 56.00 & 4855898.48 \\
## 38 & Hombre & 57.00 & 5577298.78 \\
## 39 & Hombre & 58.00 & 6507865.26 \\
## 40 & Hombre & 59.00 & 7752368.94 \\
## 41 & Hombre & 60.00 & 9499376.23 \\
## 42 & Hombre & 61.00 & 12125963.31 \\
## 43 & Hombre & 62.00 & 16511981.59 \\
## 44 & Hombre & 63.00 & 25297073.40 \\
## 45 & Hombre & 64.00 & 51679726.46 \\
## 46 & Mujer & 20.00 & 506114.75 \\
## 47 & Mujer & 21.00 & 529694.48 \\
## 48 & Mujer & 22.00 & 554591.62 \\
## 49 & Mujer & 23.00 & 580903.70 \\
## 50 & Mujer & 24.00 & 608739.21 \\
## 51 & Mujer & 25.00 & 638215.46 \\
## 52 & Mujer & 26.00 & 669460.47 \\
## 53 & Mujer & 27.00 & 702614.30 \\
## 54 & Mujer & 28.00 & 737833.53 \\
## 55 & Mujer & 29.00 & 775294.45 \\
## 56 & Mujer & 30.00 & 815192.97 \\
## 57 & Mujer & 31.00 & 857747.26 \\
## 58 & Mujer & 32.00 & 903202.14 \\
## 59 & Mujer & 33.00 & 951830.75 \\
## 60 & Mujer & 34.00 & 1003944.12 \\
## 61 & Mujer & 35.00 & 1059895.42 \\
## 62 & Mujer & 36.00 & 1120086.52 \\
## 63 & Mujer & 37.00 & 1184975.48 \\
## 64 & Mujer & 38.00 & 1255087.94 \\
## 65 & Mujer & 39.00 & 1331032.73 \\
## 66 & Mujer & 40.00 & 1413517.08 \\
## 67 & Mujer & 41.00 & 1503365.83 \\
## 68 & Mujer & 42.00 & 1601546.71 \\
## 69 & Mujer & 43.00 & 1709203.46 \\
## 70 & Mujer & 44.00 & 1827701.27 \\
## 71 & Mujer & 45.00 & 1958676.53 \\
## 72 & Mujer & 46.00 & 2104108.15 \\
## 73 & Mujer & 47.00 & 2266415.51 \\
## 74 & Mujer & 48.00 & 2448589.07 \\
## 75 & Mujer & 49.00 & 2654374.14 \\
## 76 & Mujer & 50.00 & 2888516.40 \\
## 77 & Mujer & 51.00 & 3157116.22 \\
## 78 & Mujer & 52.00 & 3468147.82 \\
## 79 & Mujer & 53.00 & 3832249.73 \\
## 80 & Mujer & 54.00 & 4263935.46 \\
## 81 & Mujer & 55.00 & 4783529.82 \\
## 82 & Mujer & 56.00 & 5420383.15 \\
## 83 & Mujer & 57.00 & 6218520.55 \\
## 84 & Mujer & 58.00 & 7247133.07 \\
## 85 & Mujer & 59.00 & 8621564.61 \\
## 86 & Mujer & 60.00 & 10549461.68 \\
## 87 & Mujer & 61.00 & 13446132.53 \\
## 88 & Mujer & 62.00 & 18280680.70 \\
## 89 & Mujer & 63.00 & 27960526.68 \\
## 90 & Mujer & 64.00 & 57022941.48 \\
## \hline
## \end{tabular}
## \end{table}
Punto I
Para la prima nivelada, se toman la suma de las esperanzas de los beneficios futuros y se divide por la suma de las esperanza del valor presente de las primas futuras, dando como resultado la prima nivelada anual.
## [1] 1252880
Punto J
Dado que la idea de este ejercicio es reducir las primas un 10%, calculo cuál es la suma que representa el 90% de las primas originales, para acercarnos a ellas.
#Calcula cuánto es el 90% de las primas obtenidas
Primas_90_porciento <- data.frame(Empleado = Primas$Empleado,
Menos_10_porciento = (Primas$Primas)*0.9)
La primera alternativa para reducir la prima 10%:
# Se calculan primas con:
# Suma asegurada de 5 millones durante el tiempo de ser empleado activo
# Suma asegurada de 5 millones durante pensión
# Primer año de pensión con mensualidad de 266.520 colones
Primas1_menos_10 <- Calcula_prima_individuales(base_empleados,tablas_supen,5000000,5000000,266520,0.04)
#se usa regla de 3 para verificar que la nueva prima sea aproximadamente el 90% de la original
Verifica1_90_porciento = data.frame(original_90 = Primas_90_porciento$Menos_10_porciento,
editada = Primas1_menos_10$Primas,
porcentaje= (Primas1_menos_10$Primas / Primas$Primas) * 100)
#Imprime el porcentaje promedio que representan las nuevas primas de las originales
print(sum(Verifica1_90_porciento$porcentaje)/nrow(Verifica1_90_porciento))
## [1] 90.05992
La Segunda alternativa para reducir la prima 10%:
# Se calculan primas con:
# Suma asegurada de 1 millón durante el tiempo de ser empleado activo
# Suma asegurada de 1 millón durante pensión
# Primer año de pensión con mensualidad de 271.900 colones
Primas2_menos_10 <- Calcula_prima_individuales(base_empleados,tablas_supen,1000000,1000000,271900,0.04)
#se usa regla de 3 para verificar que la nueva prima sea aproximadamente el 90% de la original
Verifica2_90_porciento = data.frame(original_90 = Primas_90_porciento$Menos_10_porciento,
editada = Primas2_menos_10$Primas,
porcentaje= (Primas2_menos_10$Primas / Primas$Primas) * 100)
#Imprime el porcentaje promedio que representan las nuevas primas de las originales
print(sum(Verifica2_90_porciento$porcentaje)/nrow(Verifica2_90_porciento))
## [1] 90.02407
#Primas para empleados, Hombre o Mujer y su respectiva edad
Primas_unicas_0.05 <- Calcula_prima_individuales(base_unicas,tablas_supen,5000000,1000000,300000,0.05)
Primas_unicas_0.05 <- Primas_unicas_0.05%>%
mutate(Sexo = if_else(Sexo == 1,'Hombre', 'Mujer')) %>%
select(-c(`Empleado`,`anualidad`,`beneficios`))
tabla_para_graficar_distinta_tasa <- data.frame( sexo = Primas_unicas$Sexo,
edad = Primas_unicas$Edad,
primas_normales = Primas_unicas$Primas,
primas_tasa_aumentada = Primas_unicas_0.05$Primas)
tabla_distinta_tasa_hombres <- tabla_para_graficar_distinta_tasa[tabla_para_graficar_distinta_tasa$sexo == "Hombre", ]
tabla_distinta_tasa_mujeres <- tabla_para_graficar_distinta_tasa[tabla_para_graficar_distinta_tasa$sexo == "Mujer", ]